home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / XCMDs / PioneerLDV6000.p < prev    next >
Encoding:
Text File  |  1987-08-17  |  7.2 KB  |  299 lines  |  [TEXT/ttxt]
  1. {$R-}
  2. {$D+}
  3. (*
  4.     Pioneer-LD-V6000 -- a HyperCard user-defined command 
  5.     to drive a laser disc player.
  6.     ©Apple Computer, Inc. 1987
  7.     All Rights Reserved.
  8.  
  9.  
  10.     To compile and link this file using Macintosh Programmer's Workshop
  11.     (HyperXCmd.p and XCmdGlue.inc must be accessible).
  12.  
  13.     pascal -w PioneerLDV6000.p
  14.     link -m ENTRYPOINT -o HyperCommands -rt XCMD=14 -sn Main=PioneerLDV6000 ∂
  15.       PioneerLDV6000.p.o "{MPW}"Libraries:interface.o
  16.  
  17.     then use ResEdit to copy the resulting XCMD from HyperCommands
  18.     and paste it into the Home stack, or your own stack.
  19.     (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000)
  20. *)
  21.  
  22. {$S PioneerLDV6000 }     { Segment name must be the same as the command name. }
  23.  
  24. UNIT DummyUnit;
  25.  
  26. INTERFACE
  27.  
  28.    USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
  29.     
  30. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  31.     
  32. IMPLEMENTATION
  33.  
  34. TYPE Str19 = String[19];
  35.      Str31 = String[31];
  36.  
  37. PROCEDURE PioneerLDV6000(paramPtr: XCmdPtr);                        FORWARD;
  38.  
  39.    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  40.    { entry point cannot have local procs, but forward routines can }
  41.    BEGIN
  42.      PioneerLDV6000(paramPtr);
  43.    END;
  44.  
  45.    PROCEDURE PioneerLDV6000(paramPtr: XCmdPtr);
  46.    VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
  47.        tempStr: Str255;
  48.        refNum: INTEGER;
  49.        err: INTEGER;
  50.        params: ARRAY[1..32] OF Str19;
  51.  
  52.      {$I XCmdGlue.inc }
  53.       
  54.      PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
  55.      BEGIN
  56.        paramPtr^.returnValue := PasToZero(errMsg);
  57.        EXIT(PioneerLDV6000);
  58.      END;
  59.             
  60.      PROCEDURE OpenSerial;
  61.      VAR handShake: SerShk;
  62.          baudRate: INTEGER;
  63.      BEGIN
  64.        baudRate := 9600;
  65.        { for now, use modem port so we don't mess with AppleTalk }
  66.        err := FSOpen('.AOUT',0,refNum);
  67.        IF err = 0 THEN 
  68.          BEGIN
  69.            WITH handShake DO
  70.              BEGIN
  71.                fXon := 1;
  72.                fCTS := 1;
  73.                xon  := CHR(17);
  74.                xoff := CHR(19);
  75.                errs := 0;
  76.                evts := 0;
  77.                fInx := 0;
  78.              END;
  79.            err := SerHShake(refNum,handShake);
  80.            IF err = 0 THEN 
  81.              err := Control(refNum,13,@baudRate);
  82.          END;
  83.      END;
  84.      
  85.      
  86.      PROCEDURE CloseSerial;
  87.      BEGIN
  88.        err := FSClose(refNum);
  89.      END;
  90.      
  91.      
  92.      PROCEDURE SendCommand(cmd: Str255);
  93.      VAR count: LongInt;
  94.      BEGIN
  95.        count := Length(cmd);
  96.        err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
  97.      END;
  98.      
  99.      FUNCTION Concat(str1, str2, str3: Str255): Str255;
  100.      VAR result: Str255;
  101.          resultLen: INTEGER;
  102.          charNum: INTEGER;
  103.      BEGIN
  104.        result := '';
  105.        resultLen := 0;
  106.        FOR charNum := 1 TO Length(str1) DO
  107.          BEGIN
  108.            resultLen := resultLen + 1;
  109.            result[resultLen] := str1[charNum];
  110.          END;
  111.        FOR charNum := 1 TO Length(str2) DO
  112.          BEGIN
  113.            resultLen := resultLen + 1;
  114.            result[resultLen] := str2[charNum];
  115.          END;
  116.        FOR charNum := 1 TO Length(str3) DO
  117.          BEGIN
  118.            resultLen := resultLen + 1;
  119.            result[resultLen] := str3[charNum];
  120.          END;
  121.       result[0] := CHR(resultLen);
  122.       Concat := result;
  123.      END;
  124.      
  125.      
  126.      PROCEDURE GetMessage;     
  127.      VAR paramNum, charNum: INTEGER;
  128.          msgChar: CHAR;
  129.      BEGIN
  130.        { convert params to pascal strings }
  131.        FOR paramNum := 1 TO paramPtr^.paramCount DO
  132.          BEGIN
  133.            tempStr := params[paramNum];
  134.            ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
  135.            { force all chars to lower case }
  136.            FOR charNum := 1 TO Length(tempStr) DO
  137.              BEGIN
  138.                msgChar := tempStr[charNum];
  139.                IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
  140.                  tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
  141.              END;
  142.            params[paramNum] := tempStr;
  143.          END;
  144.      END;
  145.      
  146.        
  147.      FUNCTION Contains(target: Str255): BOOLEAN;
  148.      VAR offset: INTEGER;     
  149.      
  150.        FUNCTION Match(which: INTEGER): BOOLEAN;
  151.        VAR index: INTEGER;
  152.        BEGIN
  153.          Match := TRUE;
  154.          FOR index := 1 TO Length(target) DO
  155.            IF index > Length(params[which]) THEN 
  156.              BEGIN
  157.                Match := FALSE;  { ran off the end }
  158.                EXIT(Match);
  159.              END
  160.            ELSE IF target[index] <> params[which][index] THEN
  161.              BEGIN
  162.                Match := FALSE;  { hit a wrong char }
  163.                EXIT(Match);
  164.              END;
  165.        END;
  166.        
  167.      BEGIN
  168.        Contains := FALSE;
  169.        FOR offset := 1 TO paramPtr^.paramCount DO
  170.          IF Match(offset) THEN
  171.            BEGIN
  172.              Contains := TRUE;
  173.              EXIT(Contains);
  174.            END;
  175.      END;
  176.      
  177.      
  178.      FUNCTION GetDigit(digit: CHAR): Str255;
  179.      BEGIN
  180.        CASE digit OF
  181.          '0': GetDigit := '3F';
  182.          '1': GetDigit := '0F';
  183.          '2': GetDigit := '8F';
  184.          '3': GetDigit := '4F';
  185.          '4': GetDigit := '2F';
  186.          '5': GetDigit := 'AF';
  187.          '6': GetDigit := '6F';
  188.          '7': GetDigit := '1F';
  189.          '8': GetDigit := '9F';
  190.          '9': GetDigit := '5F';
  191.        END;
  192.      END;
  193.   
  194.   
  195.      FUNCTION GetInteger: Str255;
  196.      { get an integer in Pioneer format }
  197.      VAR which, digitLoc, charVal: INTEGER;
  198.          intStr:            Str255;
  199.      BEGIN
  200.        intStr := '';
  201.        FOR which := 1 TO paramPtr^.paramCount DO
  202.          BEGIN
  203.            charVal := ORD(params[which][1]);
  204.            IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
  205.              BEGIN
  206.                FOR digitLoc := 1 TO Length(params[which]) DO
  207.                  intStr := Concat(intStr, GetDigit(params[which][digitLoc]),'');
  208.                GetInteger := intStr;
  209.                  exit(GetInteger);
  210.              END;
  211.          END;
  212.        GetInteger := intStr;    { just in case }
  213.      END;
  214.  
  215.    BEGIN
  216.      OpenSerial;
  217.      IF err <> 0 THEN 
  218.        BEGIN
  219.          SysBeep(1);
  220.          Fail('Could not open serial port');
  221.        END;
  222.      
  223.      GetMessage;
  224.      
  225.      { set flags }
  226.      reverseFlag := Contains('rev');
  227.      offFlag := Contains('off');
  228.      tillFlag := Contains('till');
  229.      
  230.      IF Contains('stop') THEN SendCommand('@FB')
  231.      ELSE IF Contains('eject') THEN SendCommand('@F9')
  232.      ELSE IF Contains('search') THEN SendCommand(Concat('@', GetInteger, 'F7'))
  233.      ELSE IF Contains('step') THEN
  234.        BEGIN
  235.          IF NOT reverseFlag THEN SendCommand('@F6')        {step fwd}
  236.          ELSE SendCommand('@FE')                        {step rev}
  237.        END
  238.      ELSE IF Contains('play') THEN
  239.        BEGIN
  240.          IF NOT tillFlag THEN
  241.              BEGIN
  242.                 IF NOT reverseFlag THEN SendCommand('@FD')    {play fwd}
  243.                  ELSE SendCommand('@0FECFA');                 {play rev}
  244.             END
  245.          ELSE SendCommand(Concat('@', GetInteger, 'F3'))    {play till}
  246.        END
  247.      ELSE IF Contains('slow') THEN
  248.        BEGIN
  249.          IF NOT reverseFlag THEN SendCommand('@4FEDF2')        {slow fwd}
  250.          ELSE SendCommand('@4FEDFA')                        {slow rev}
  251.        END
  252.      ELSE IF Contains('fast') THEN
  253.        BEGIN
  254.          IF NOT reverseFlag THEN SendCommand('@4FECF2')        {fast fwd}
  255.          ELSE SendCommand('@4FECFA')                        {fast rev}
  256.        END
  257.      ELSE IF Contains('scan') THEN
  258.        BEGIN
  259.          IF NOT reverseFlag THEN SendCommand('@4FECF2')        {scan fwd}
  260.          ELSE SendCommand('@4FECFA')                        {scan rev}
  261.        END
  262.      ELSE IF Contains('picture') THEN
  263.        BEGIN
  264.          IF NOT offFlag THEN SendCommand('@1B')                {picture on}
  265.          ELSE SendCommand('@1C')                            {picture off}
  266.        END
  267.      ELSE IF Contains('frame') THEN
  268.        BEGIN
  269.          IF NOT offFlag THEN SendCommand('@0FF1')            {frame on}
  270.          ELSE SendCommand('@3FF1')                            {frame off}
  271.        END
  272.      ELSE IF Contains('sound') THEN 
  273.        BEGIN
  274.          IF Contains('1') THEN
  275.            IF NOT offFlag THEN SendCommand('@0FF4')            {sound 1 on}
  276.            ELSE SendCommand('@3FF4')                        {sound 1 off}
  277.          ELSE IF Contains('2') THEN
  278.            IF NOT offFlag THEN SendCommand('@0FFC')            {sound 2 on}
  279.            ELSE SendCommand('@3FFC')                        {sound 2 off}
  280.          ELSE
  281.            BEGIN
  282.              CloseSerial;
  283.              Fail('Unknown video sound channel');
  284.            END;
  285.        END
  286.      ELSE IF NOT Contains('init') THEN { init does nothing for this player }
  287.         BEGIN
  288.           CloseSerial;
  289.           SysBeep(1); 
  290.           Fail('Unknown video command');
  291.         END;
  292.      CloseSerial;
  293.    END;   
  294.  
  295. END.
  296.  
  297.  
  298.  
  299.